home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / rs6000 / rs6000.sml next >
Encoding:
Text File  |  1993-01-27  |  20.0 KB  |  667 lines

  1. (* Copyright (c) 1992 by AT&T Bell Laboratories *)
  2.  
  3. (* IBM RS6000 Cmachine implementation *)
  4.  
  5. functor RS6000CM (structure C : CODER
  6.              sharing type C.instruction = RS6000InstrSet.instruction
  7.               and type C.sdi = RS6000InstrSet.sdi) : CMACHINE =
  8. struct
  9.  
  10.   structure M = RS6000InstrSet
  11.   open M
  12.  
  13.   val error         = fn msg => ErrorMsg.impossible ("RS6kCM." ^ msg)
  14.  
  15.   type EA        = C.label M.EA
  16.   exception BadReal     = C.BadReal
  17.   val align        = fn () => ()
  18.   val mark         = C.mark
  19.   val emitlong         = C.emitLong
  20.   val realconst     = C.emitReal
  21.   val emitstring     = C.emitString
  22.   val newlabel         = M.ImmedLab o C.newLabel
  23.   val immed           = M.Immed
  24.   val emitSDI        = C.emitSDI
  25.   val emit        = C.emit
  26.  
  27.   fun emitlab(k,ImmedLab lab) = C.emitLabel(lab,k)
  28.     | emitlab _ = error "emitlab"
  29.  
  30.   fun define(ImmedLab lab) = C.define lab
  31.     | define _ = error "RS6kCM.define"
  32.  
  33.   (** 
  34.      Register Map
  35.      Reg   gc   desc
  36.      -------------------------------------
  37.      0       n   odd ball register
  38.      1       n   stack pointer    (not used in ML)
  39.      2     n   TOC         (not used in ML)
  40.      3-13  y   miscregs
  41.      14       y   data pointer
  42.      15       n   heap limit 
  43.      16       y   store pointer
  44.      17    y   standardlink
  45.      18    y   standardclosure
  46.      19    y   standardarg
  47.      20    y   standardcont
  48.      21    y   exception pointer
  49.      22    y   varptr
  50.      23    y   base pointer
  51.      24-27 y   misc regs
  52.      28    n   temporary (also gclink)
  53.      29-31 n   temporaries
  54.   **)
  55.  
  56.   val varptr_indexable            = true
  57.   val stackptr as Direct stackptr' = Direct(M.stackReg)
  58.  
  59.   val dataptr  as Direct dataptr'  = Direct(M.allocReg)
  60.   val limitptr as Direct limitptr' = Direct(M.limitReg)
  61.   val storeptr as Direct storeptr' = Direct(Reg 16)
  62.   val standardlink           = Direct(Reg 17)
  63.   val standardclosure           = Direct(Reg 18)
  64.   val standardarg           = Direct(Reg 19)
  65.   val standardcont           = Direct(Reg 20)
  66.   val exnptr                 = Direct(M.exnptrReg)
  67.   val varptr                = Direct(Reg 22)
  68.   val miscregs                = map (Direct o Reg) 
  69.                            [24,25,26,27,3,4,5,6,7,8,9,10,11,12,13]
  70.   val gcLinkReg               = Reg 28
  71.  
  72.   val floatregs: EA list       = map (Direct o Freg)
  73.                            [1,2,3,4,5,6,7,8,9,10,11,12,13]
  74.   val savedfpregs: EA list       = map (Direct o Freg) 
  75.                      [14,15,16,17,18,19,20,21,22,23,
  76.                       24,25,26,27,28,29,30,31]
  77.   val arithtemps: EA list       = []
  78.   val tmpFreg               = Freg 0
  79.  
  80.   local
  81.       exception NoTmpRegs
  82.       val front        = ref 0
  83.       val back        = ref 0
  84.       val tmpRegs    = [M.maskReg,Reg 30,Reg 31]
  85.       val qsize        = length tmpRegs + 1
  86.       val queue     = Array.array(qsize,~1)
  87.       fun insert(Reg r) = Array.update(queue,!back,r) 
  88.                   before back := (!back+1) mod qsize
  89.     | insert _      = error "insert"
  90.       fun remove()     = if !front = !back then raise NoTmpRegs
  91.               else Array.sub(queue,!front) 
  92.                    before front := (!front+1) mod qsize
  93.       val _ = app insert tmpRegs
  94.   in  
  95.       fun getTmpReg()    = Reg(remove())
  96.       fun freeTmpReg reg = insert reg                    
  97.   end
  98.  
  99.   fun emitBRANCH(cond,bool,lab) = 
  100.       let val flabel = C.newLabel()
  101.       val tmpR = getTmpReg()
  102.       in 
  103.       emitSDI(M.BRANCH(cond,bool,lab,tmpR,flabel));
  104.       C.define flabel;
  105.       freeTmpReg tmpR
  106.       end
  107.  
  108.   fun emitFBRANCH(cond,cr,bool,lab) = 
  109.       let val flabel = C.newLabel()
  110.       val tmpR = getTmpReg()
  111.       in
  112.       emitSDI(M.FBRANCH(cond,cr,bool,lab,tmpR,flabel));
  113.       C.define flabel;
  114.       freeTmpReg tmpR
  115.       end
  116.  
  117.   datatype immedSize = IMMED16 | IMMED32
  118.  
  119.   fun immed_size n = if (~32768 <= n) andalso (n < 32768) then IMMED16
  120.              else IMMED32
  121.  
  122.   fun do_immed_signed(instr,rt,ra,si) = 
  123.       case (immed_size si) 
  124.     of IMMED16 => emit (instr(rt,ra,Immed16Op si))
  125.          | IMMED32 => let
  126.            val (hi,lo) = M.split si
  127.            val tmpR = getTmpReg()
  128.        in
  129.            emit (M.LIU(tmpR, Immed16Op hi));
  130.            emit (M.A(tmpR,tmpR,Immed16Op lo));
  131.            emit (instr(rt,ra,RegOp tmpR));
  132.            freeTmpReg tmpR
  133.            end
  134.  
  135.   fun load_immed(rt,n) = 
  136.       case (immed_size n) 
  137.         of IMMED16 => emit (M.CAL(rt,Reg 0,Immed16Op n))
  138.          | IMMED32 => let
  139.            val (hi,lo) = M.split n
  140.            in
  141.            emit (M.LIU(rt,Immed16Op hi));
  142.            emit (M.A(rt,rt,Immed16Op lo))
  143.            end
  144.            
  145.  (* move(a,b) means a -> b *)
  146.   fun move (Direct(fp1 as Freg _),Direct(fp2 as Freg _)) = emit (M.FMR(fp2,fp1))
  147.     | move (_, Direct(Freg _))        = error "move: bad src"
  148.     | move (Immed n, Direct dst)      = load_immed(dst,n)
  149.     | move (ImmedLab lab, Direct dst) = emitSDI(LOADADDR(dst,lab,0))
  150.     | move (Direct src, Direct dst)   = if src = dst 
  151.                         then ()
  152.                         else emit (M.AND(dst,src,RegOp src))
  153.     | move _                   = error "move"
  154.  
  155.   fun compare_immed(ra,n) = 
  156.       if   n >= ~32768 andalso n <= 32767 
  157.       then emit (M.CMP(ra,Immed16Op n))
  158.       else let val tmpR = getTmpReg()
  159.        in 
  160.            move(Immed n,Direct tmpR);
  161.            emit (M.CMP(ra,RegOp tmpR));
  162.            freeTmpReg tmpR
  163.        end
  164.  
  165.   fun jmp (Direct r)     = (emit (M.MTSPR(M.LR,r)); emit (M.BR()))
  166.     | jmp (ImmedLab lab) = emit (B(Label24Off(M.POSLAB lab,0)))
  167.     | jmp _         = error "jmp"
  168.  
  169.  
  170.   val startgc_offset = 4
  171.  
  172.   fun testLimit() = emit (M.CMPL(limitptr',dataptr'))
  173.  
  174.   fun beginStdFn (ImmedLab lab,Direct reg) = emitSDI(M.SETBASEADDR(lab,reg))
  175.     | beginStdFn _                 = error "beginStdFn"
  176.  
  177.   fun checkLimit(max_allocation, restart, mask) = let
  178.         val lab = C.newLabel()
  179.     val tmpR = getTmpReg()
  180.      in 
  181.      if max_allocation > 4096 
  182.          then (do_immed_signed(M.A,tmpR,dataptr',max_allocation-4096);
  183.            emit (M.CMPL(limitptr',tmpR)))
  184.      else ();
  185.      emitBRANCH(M.GT,true,lab);
  186.      emit (M.L(tmpR,stackptr',Immed16Op startgc_offset));
  187.      emit (M.MTSPR(M.LR,tmpR));
  188.      freeTmpReg tmpR;
  189.      move(mask, Direct M.maskReg);
  190.      move(restart, Direct gcLinkReg);
  191.      emit (M.BR());
  192.      C.define lab
  193.      end     
  194.  
  195.  (* jmpindexb(x,y) means pc <- x + y *)
  196.   fun jmpindexb (ImmedLab lab,Direct y) = let
  197.         val tmpR = getTmpReg()
  198.       in
  199.       emitSDI(M.LOADADDR(tmpR,lab,0));
  200.       emit (M.A(tmpR,y,RegOp tmpR));
  201.       emit (M.MTSPR(M.LR,tmpR));
  202.       freeTmpReg tmpR;
  203.       emit (M.BR())
  204.       end
  205.     | jmpindexb _ = error "jmpindexb"
  206.  
  207.   fun record(vl, Direct z) = let
  208.         open CPS
  209.     val len = List.length vl
  210.     fun f(_,i,nil) = ()
  211.       | f((t1,t2),i,(Direct r, SELp(j,p))::rest) = 
  212.            (** follow ptrs to get the item  **)
  213.             (do_immed_signed(M.L,t1,r,j*4);
  214.          f((t2,t1),i,(Direct t1,p)::rest))
  215.       | f(t,i,(Direct r,OFFp 0)::rest) = 
  216.            (**  simple store, last first  **) 
  217.             (do_immed_signed(M.ST,r,dataptr',i*4);
  218.          f(t,i-1,rest))
  219.       | f((t1,t2),i,(Direct r, OFFp j)::rest) = 
  220.         (emit (M.A(t1,r,Immed16Op(4*j))); 
  221.          f((t2,t1),i,(Direct t1,OFFp 0)::rest))
  222.       | f((t1,t2),i,(ea,p)::rest) =
  223.            (* convert to register-based  *)
  224.         (move(ea,Direct t1);  
  225.          f((t2,t1),i,(Direct t1,p)::rest))
  226.     val tmpR1 = getTmpReg()
  227.     val tmpR2 = getTmpReg()
  228.       in 
  229.        (* store first word in 0(dataptr') *)
  230.     f((tmpR1,tmpR2),len-1,rev vl); 
  231.     freeTmpReg tmpR1;
  232.     freeTmpReg tmpR2;
  233.     emit (M.A(z,dataptr',Immed16Op 4));
  234.     do_immed_signed(M.A,dataptr',dataptr',4*len)
  235.       end
  236.     | record _ = error "record"
  237.  
  238.     fun recordStore (x, y, _) = 
  239.     record ([(Immed(System.Tags.make_desc(3, System.Tags.tag_record)), 
  240.           CPS.OFFp 0),(x, CPS.OFFp 0), (y, CPS.OFFp 0), 
  241.          (storeptr, CPS.OFFp 0)], 
  242.         storeptr)
  243.  
  244.   fun select (i,Direct v',Direct w)    = do_immed_signed(M.L,w,v',i*4)
  245.     | select (i,ImmedLab lab,Direct w) = emitSDI(LOAD(w,lab,i*4))
  246.     | select _                    = error "select"
  247.  
  248.  
  249.   fun offset (i,Direct v',Direct w)    = do_immed_signed(M.A,w,v',i*4)
  250.     | offset (i,ImmedLab lab,Direct w) = let val tmpR = getTmpReg()
  251.                      in
  252.                          emitSDI(LOADADDR(tmpR,lab,0));
  253.                          do_immed_signed(M.A,w,tmpR,i*4);
  254.                          freeTmpReg tmpR
  255.                      end
  256.     | offset _                    = error "offset"
  257.  
  258.  
  259.   fun fetchindexb(Direct x,Direct y,Immed indx) = do_immed_signed(M.LBZ,y,x,indx)
  260.     | fetchindexb(Direct x,Direct y,Direct indx)= emit (M.LBZ(y,x,RegOp indx))
  261.     | fetchindexb _                 = error "fetchindexb"
  262.  
  263.  
  264.   fun storeindexb(Immed xi,y,z) = let 
  265.          val tmpR = getTmpReg()
  266.       in
  267.       load_immed(tmpR,xi);
  268.       storeindexb(Direct tmpR,y,z);
  269.       freeTmpReg tmpR
  270.       end
  271.     | storeindexb(Direct x,Direct y,Direct indx)= emit (M.STB(x,y,RegOp indx))
  272.     | storeindexb(Direct x,Direct y,Immed indx) = do_immed_signed(M.STB,x,y,indx)
  273.     | storeindexb _                 = error "storeindexb"
  274.  
  275.   fun fetchindexl(x,Direct y,Direct z') = let
  276.         val tmpR = getTmpReg()
  277.       in
  278.       emit (M.SL(tmpR,z',M.Int5Shift 1));
  279.       (case x 
  280.          of Direct x'    => ( emit (M.A(tmpR,x',RegOp tmpR));
  281.                       emit (M.L(y,tmpR,Immed16Op ~2)))
  282.           | Immed n      => do_immed_signed(M.L,y,tmpR,n-2)
  283.           | ImmedLab lab => 
  284.            let val tmpR2 = getTmpReg()
  285.            in
  286.                emitSDI(M.LOADADDR(tmpR2,lab,0));
  287.                emit (M.A(tmpR,tmpR,RegOp tmpR2));
  288.                freeTmpReg tmpR2;
  289.                emit (M.L(y,tmpR,Immed16Op ~2))
  290.            end);
  291.       freeTmpReg tmpR
  292.       end
  293.     | fetchindexl(x,Direct y,Immed z') =  
  294.       (case x
  295.      of Direct x'    => do_immed_signed(M.L,y,x',2*(z'-1))
  296.       | Immed n      => do_immed_signed(M.L,y,Reg 0,n+2*(z'-1))
  297.       | ImmedLab lab => emitSDI(LOAD(y,lab,2*(z'-1))))
  298.     | fetchindexl _ = error "fetchindexl"
  299.  
  300.   fun storeindexl(Direct x,Direct y,Direct z) = let
  301.         val tmpR = getTmpReg()
  302.       in 
  303.         emit (M.SL(tmpR,z,Int5Shift 1));
  304.     emit (M.A(tmpR,tmpR,RegOp y));
  305.     emit (M.ST(x,tmpR,Immed16Op ~2));
  306.     freeTmpReg tmpR
  307.       end
  308.     | storeindexl(Direct x,Direct y,Immed zi) = 
  309.         do_immed_signed(M.ST,x,y,2*(zi-1))
  310.     | storeindexl(Immed xi,y,z) =  let val tmpR = getTmpReg()
  311.                    in
  312.                        move(Immed xi,Direct tmpR);
  313.                        storeindexl(Direct tmpR,y,z);
  314.                        freeTmpReg tmpR
  315.                    end
  316.     | storeindexl(ImmedLab lab,y,z) = let val tmpR = getTmpReg()
  317.                       in
  318.                       emitSDI(M.LOADADDR(tmpR,lab,0));
  319.                       storeindexl(Direct tmpR,y,z);
  320.                       freeTmpReg tmpR
  321.                       end
  322.     | storeindexl(Direct x,ImmedLab lab,Immed zi) = let
  323.         val tmpR = getTmpReg()
  324.       in
  325.       emitSDI(M.LOADADDR(tmpR,lab,0));  
  326.       do_immed_signed(M.ST,x,tmpR,2*(zi-1));
  327.       freeTmpReg tmpR
  328.       end
  329.     | storeindexl _ = error "MipsCM.storeindexl: bad args"
  330.  
  331.   local
  332.     fun three f (Direct x',Direct y',Immed zi)     = do_immed_signed(f,x',y',zi)
  333.       | three f (Direct x',Direct y',Direct z')    = emit (f(x',y',RegOp z'))
  334.       | three f (Direct x',Direct y',ImmedLab lab) = let
  335.       val tmpR = getTmpReg()
  336.     in
  337.         emitSDI(M.LOADADDR(tmpR,lab,0));  
  338.         emit (f(x',y',RegOp tmpR));
  339.         freeTmpReg tmpR
  340.     end
  341.       | three f (Direct x,ea,Direct z) = three f (Direct x,Direct z,ea)
  342.       | three _ _                = error "MipsCM.three: bad args"
  343.   in
  344.     fun add(x,y,z)         = three M.A   (z,x,y)
  345.     fun orb(x,y,z)         = three M.OR  (z,x,y) 
  346.     fun andb(x,y,z)        = three M.AND (z,x,y)
  347.     fun xorb(x,y,z)        = three M.XOR (z,x,y)
  348.   end
  349.  
  350.   fun trapOnOverflow () = let val lab = C.newLabel()
  351.               in 
  352.                   emitBRANCH(M.SO,false,lab);
  353.                   emit(M.TRAP());
  354.                   C.define lab
  355.               end
  356.   fun trapOnDivZero () = let val lab = C.newLabel()
  357.              in 
  358.                  emitBRANCH(M.SO,false,lab);
  359.                  emit(MTFSB1 5);
  360.                  emit(M.TRAP());
  361.                  C.define lab
  362.              end
  363.   local 
  364.     fun move2reg (Direct(Reg r)) = (Reg r,NONE)
  365.       | move2reg (Immed n)       = let val tmpR = getTmpReg()
  366.                    in 
  367.                        move(Immed n, Direct tmpR);
  368.                        (tmpR,SOME tmpR)
  369.                    end
  370.       | move2reg (ImmedLab lab)  = let val tmpR = getTmpReg()
  371.                    in 
  372.                        move(ImmedLab lab, Direct tmpR);
  373.                        (tmpR, SOME tmpR)
  374.                    end
  375.       | move2reg _          = error "move2reg"
  376.  
  377.     fun free NONE = () 
  378.       | free (SOME r) = freeTmpReg r
  379.   in
  380.     fun addt(x,y,Direct z) = let val (x',tmpx) = move2reg x
  381.                  val (y',tmpy) = move2reg y
  382.                  in 
  383.                  emit (M.AO(z,x',y'));
  384.                  trapOnOverflow();
  385.                  free tmpx; 
  386.                  free tmpy
  387.                  end
  388.       | addt _            = error "addt"
  389.                       
  390.     fun mult(x,Direct y) = let val (x',tmpx) = move2reg x
  391.                in
  392.                    emit (MULSO(y,x',y));
  393.                    trapOnOverflow();
  394.                    free tmpx
  395.                end
  396.       | mult _          = error "mult"
  397.   end
  398.  
  399.   fun sub (Direct x,Direct y,Direct z) = emit (M.SF(z,x,RegOp y))
  400.     | sub (Direct x,Immed yi,Direct z) = do_immed_signed(M.SF,z,x,yi)
  401.     | sub (Immed xi,y,z)               = let  val tmpR = getTmpReg()
  402.                      in
  403.                          move(Immed xi,Direct tmpR);
  404.                          sub(Direct tmpR,y,z);
  405.                          freeTmpReg tmpR
  406.                      end
  407.     | sub _                   = error "sub"
  408.  
  409.   fun notb(a,b)    = sub(a, Immed ~1, b)
  410.  
  411.   local 
  412.       fun subtract(Direct x,Direct y,Direct z) = emit (SFO(z,x,y))
  413.     | subtract(Immed xi,y,z)  = let val tmpR = getTmpReg()
  414.                     in
  415.                     move(Immed xi,Direct tmpR);
  416.                     subtract(Direct tmpR,y,z);
  417.                     freeTmpReg tmpR
  418.                     end
  419.     | subtract(x,Immed yi,z)  = let val tmpR = getTmpReg()
  420.                     in 
  421.                     move(Immed yi,Direct tmpR);
  422.                     subtract(x,Direct tmpR,z);
  423.                     freeTmpReg tmpR
  424.                     end
  425.     | subtract _               = error "subtract"
  426.   in
  427.       fun subt arg = (subtract arg; trapOnOverflow())
  428.   end
  429.  
  430.             (* divt(a,b) means b <- b / a *)
  431.   local
  432.     fun divide (Direct x,Direct y) = emit (M.DIVS(y,y,x))
  433.       | divide (Immed xi,Direct y) = let val tmpR = getTmpReg()
  434.                      in 
  435.                      move(Immed xi,Direct tmpR);
  436.                      emit (M.DIVS(y,y,tmpR));
  437.                      freeTmpReg tmpR
  438.                      end
  439.       | divide _           = error "divide"
  440.   in
  441.       fun divt arg = (divide arg; trapOnDivZero())
  442.   end
  443.                       
  444.   fun ashl (Direct rs,Direct rt,Direct rd) = emit (M.SL(rd,rt,RegShift rs))
  445.     | ashl (Immed n,Direct rt,Direct rd) = 
  446.       if n >= 32 orelse n < 0 then
  447.       error "ashl: shift distance"
  448.       else
  449.       emit (M.SL(rd,rt,Int5Shift n))
  450.     | ashl(shamt,Immed n,dst) = let 
  451.         val tmpR = getTmpReg()
  452.       in  
  453.       move(Immed n, Direct tmpR);
  454.       ashl(shamt,Direct tmpR,dst);
  455.       freeTmpReg tmpR
  456.       end
  457.     | ashl _ = error "ashl"
  458.  
  459.   fun ashr (Direct rs,Direct rt,Direct rd) = 
  460.       emit (M.SRA(rd,rt,RegShift rs))
  461.     | ashr (Immed n,Direct rt,Direct rd) = 
  462.       if n >= 32 orelse n < 0 then
  463.       error "ashr: shift distance"
  464.       else
  465.       emit (M.SRA(rd,rt,Int5Shift n))
  466.     | ashr(shamt,Immed n,dst) = let
  467.         val tmpR = getTmpReg()
  468.       in  
  469.       move(Immed n,Direct tmpR);
  470.       ashr(shamt,Direct tmpR,dst);
  471.       freeTmpReg tmpR
  472.       end
  473.     | ashr _ = error "MipsCM.ashr: bad args"
  474.  
  475.   local 
  476.     fun floatreg (Direct(fpr as Freg _)) = fpr
  477.       | floatreg _              = error "floatreg"
  478.  
  479.     fun floating_arith f (x,y,z) = let 
  480.           val lab = C.newLabel()
  481.     in
  482.         emit (f(floatreg x,floatreg y,floatreg z));
  483.         emitFBRANCH(M.FEX,1,false,lab);
  484.         emit(M.TRAP());
  485.         C.define lab
  486.         end
  487.  
  488.     val real_tag = System.Tags.desc_reald
  489.  
  490.     fun store_float(Freg fp,Direct dst,offset) = let
  491.       val tmpR = getTmpReg()
  492.         in
  493.         emit(M.STFD(Freg fp,stackptr',Immed16Op M.fLoadStoreOff));
  494.         emit(M.L(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
  495.         do_immed_signed(M.ST,tmpR,dst,offset);
  496.         emit(M.L(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
  497.         do_immed_signed(M.ST,tmpR,dst,offset+4);
  498.         freeTmpReg tmpR
  499.     end
  500.       | store_float _ = error "store_float"        
  501.  
  502.     fun load_float (Freg dst,Direct src,offset) = let
  503.       val tmpR = getTmpReg()
  504.         in
  505.         do_immed_signed(M.L,tmpR,src,offset);
  506.         emit(M.ST(tmpR,stackptr',Immed16Op M.fLoadStoreOff));
  507.         do_immed_signed(M.L,tmpR,src,offset+4);
  508.         emit(M.ST(tmpR,stackptr',Immed16Op(M.fLoadStoreOff+4)));
  509.         emit(M.LFD(Freg dst,stackptr',Immed16Op M.fLoadStoreOff));
  510.         freeTmpReg tmpR
  511.         
  512.         end
  513.       | load_float (Freg dst,ImmedLab lab,offset) = let
  514.        val tmpR = getTmpReg()
  515.     in
  516.         emitSDI(LOADF(Freg dst,lab,offset,tmpR));
  517.         freeTmpReg tmpR
  518.     end
  519.       | load_float _ = error "load_float"
  520.   in
  521.       fun fmuld(x,y,z)         = floating_arith M.FMO (z,x,y)
  522.       fun fdivd(x,y,z)         = floating_arith M.FDO (z,x,y)
  523.       fun faddd(x,y,z)         = floating_arith M.FAO (z,x,y)
  524.       fun fsubd(x,y,z)         = floating_arith M.FSO (z,x,y)
  525.       fun fnegd(op1,result) = emit (M.FNEG(floatreg result,floatreg op1))
  526.       fun fabsd(op1,result) = emit (M.FABS(floatreg result,floatreg op1))
  527.  
  528.       fun storefloat(src,Direct(Reg result)) =
  529.         (store_float(floatreg src,dataptr,4);
  530.          let val tmpR = getTmpReg()
  531.          in
  532.          load_immed(tmpR,real_tag);
  533.          emit (M.ST(tmpR,dataptr',Immed16Op 0));
  534.          emit (M.A(Reg result,dataptr',Immed16Op 4));
  535.          emit (M.A(dataptr',dataptr',Immed16Op 12));
  536.          freeTmpReg tmpR
  537.          end)
  538.     | storefloat  _ = error "storefloat"
  539.   
  540.       fun loadfloat(src, dst) = load_float(floatreg dst,src,0)
  541.  
  542.      (* fetchindexd (x,y,z) y <- mem[x+4*(z-1)] *)
  543.       fun fetchindexd (Direct x,y,Immed i) = 
  544.         load_float(floatreg y, Direct x, 4*(i-1))
  545.     | fetchindexd (Direct x,y,Direct z) = let
  546.         val tmpR = getTmpReg()
  547.         in
  548.         emit (M.SL(tmpR,z,Int5Shift 2));
  549.         emit (M.A(tmpR,x,RegOp tmpR));
  550.         load_float(floatreg y,Direct tmpR,~4);
  551.         freeTmpReg tmpR
  552.       end
  553.     | fetchindexd _ = error "fetchindexd"
  554.  
  555.     fun storeindexd (x,Direct y,Immed i) = 
  556.       store_float(floatreg x,Direct y, 4*(i-1))
  557.       | storeindexd (x,Direct y,Direct z) = let
  558.           val tmpR = getTmpReg()
  559.     in
  560.         emit (M.SL(tmpR,z,Int5Shift 2));
  561.         emit (M.A(tmpR,y,RegOp tmpR));
  562.         store_float(floatreg x,Direct tmpR,~4);
  563.         freeTmpReg tmpR
  564.         end
  565.       | storeindexd _ = error "storeindexd"        
  566.   end
  567.  
  568.   datatype condition = NEQ | EQL | LEQ | GEQ | LSS | GTR
  569.  
  570.   local
  571.     fun compare(ra,Immed si) = compare_immed(ra,si)
  572.       | compare (ra,Direct rb) = emit (M.CMP(ra,RegOp rb))
  573.       | compare _ = error "compare"
  574.  
  575.     fun branch(cond,lab) =        
  576.     case cond
  577.       of NEQ => emitBRANCH(M.EQ,false,lab)
  578.        | EQL => emitBRANCH(M.EQ,true,lab)
  579.        | GTR => emitBRANCH(M.GT,true,lab)
  580.        | LEQ => emitBRANCH(M.GT,false,lab)
  581.        | LSS => emitBRANCH(M.LT,true,lab)
  582.        | GEQ => emitBRANCH(M.LT,false,lab)
  583.   in
  584.     fun ibranch(cond,Immed a,Immed b,ImmedLab lab) =
  585.     if  (case cond of EQL => a=b  | NEQ => a<>b | LSS => a<b |
  586.               LEQ => a<=b | GTR => a>b  | GEQ => a>=b)  
  587.     then emit (M.B(Label24Off(POSLAB lab,0)))
  588.     else  ()
  589.       | ibranch(cond,Direct rs,Immed n,ImmedLab lab) = 
  590.       (compare_immed(rs,n); branch(cond,lab))
  591.       | ibranch(cond,Immed n,rb,lab) = let
  592.       val tmpR as Direct tmpR' = Direct(getTmpReg())
  593.         in
  594.        move(Immed n,tmpR);
  595.        ibranch(cond,tmpR,rb,lab);
  596.        freeTmpReg tmpR'
  597.         end
  598.       | ibranch(cond,Direct ra,Direct rb,ImmedLab lab) = 
  599.       (compare(ra,Direct rb); branch(cond,lab))
  600.       | ibranch _ = error "ibranch"
  601.   end
  602.  
  603.   fun fbranchd(cond,Direct fra,Direct frb,ImmedLab lab) = 
  604.         (emit (M.FCMP(fra,frb));
  605.      case cond 
  606.        of NEQ => emitFBRANCH(M.FE,2,false,lab)
  607.         | EQL => emitFBRANCH(M.FE,2,true,lab)
  608.         | GEQ => emitFBRANCH(M.FL,2,false,lab)
  609.         | LSS => emitFBRANCH(M.FL,2,true,lab)
  610.         | GTR => emitFBRANCH(M.FG,2,true,lab)
  611.         | LEQ => emitFBRANCH(M.FG,2,false,lab))
  612.     | fbranchd _ = error "fbranch"
  613.  
  614.  (* 
  615.   * rangeChk (a, b, lab):  pc <- lab if ((a < 0) or (b <= a)) 
  616.   *)
  617.   fun rangeChk(Immed a,Immed b,ImmedLab lab) =
  618.         if a<0 orelse a>=b then emit (M.B (Label24Off(POSLAB lab,0))) else ()
  619.     | rangeChk(Immed a, b, ImmedLab lab) =
  620.         if a<0 then emit (M.B (Label24Off(POSLAB lab,0)))
  621.         else ibranch(GEQ,Immed a,b, ImmedLab lab)
  622.     | rangeChk(Direct a, Direct b, ImmedLab lab) = let
  623.         val tmpR = getTmpReg()
  624.       in
  625.       emit (M.CMPL(a,b));
  626.       emitBRANCH(M.LT,false,lab);
  627.       freeTmpReg tmpR
  628.       end
  629.     | rangeChk(a,Immed n,lab) = let
  630.         val tmpR = getTmpReg()
  631.       in
  632.       move(Immed n, Direct tmpR);
  633.       rangeChk(a,Direct tmpR,lab);
  634.       freeTmpReg tmpR
  635.       end
  636.     | rangeChk _ = error "rangeChk"
  637.  
  638.  (* Should implement ANDcc and do this better *)
  639.   fun bbs(Immed k,Direct y,ImmedLab label) =
  640.       let val tmpR = getTmpReg()
  641.       in
  642.       do_immed_signed(M.AND,tmpR,y,Bits.lshift(1,k));
  643.       compare_immed(tmpR,Bits.lshift(1,k));
  644.       freeTmpReg tmpR;
  645.       emitBRANCH(M.EQ,true,label)
  646.       end
  647.     | bbs _ = error "MipsCM.bbs: bad args"
  648.  
  649.  
  650.   val cvti2dTmpOffset   = 16
  651.   val cvti2dConstOffset = 8
  652.   fun cvti2d(Direct(src as Reg _),Direct(dst as Freg _)) = let
  653.       val tmpR = getTmpReg()
  654.     in
  655.     emit(M.XORU(tmpR,src,Immed16Op 32768));
  656.     emit(M.ST(tmpR,stackptr',Immed16Op(cvti2dTmpOffset+4)));
  657.     emit(M.LIU(tmpR,Immed16Op 17200));
  658.     emit(M.ST(tmpR,stackptr',Immed16Op cvti2dTmpOffset));
  659.     emit(M.LFD(dst,stackptr',Immed16Op cvti2dTmpOffset));
  660.         emit(M.LFD(tmpFreg,stackptr',Immed16Op cvti2dConstOffset));
  661.     emit(M.FSO(dst,dst,tmpFreg));
  662.     freeTmpReg tmpR
  663.     end
  664.  
  665.   val comment = C.comment
  666. end
  667.